home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / qbtree55.zip / XBTREE1.BAS < prev    next >
BASIC Source File  |  1991-07-31  |  7KB  |  250 lines
  1.  
  2. REM $INCLUDE: 'QBTREE.BI'
  3.  
  4. DEFINT A-Z
  5.  
  6. 'QBTree sample 1
  7. '-read data from an ASCII fixed-length record file
  8. '-create a QBTree data and index file
  9. '-count all records to measure key access time
  10. '-list all records just to look at them
  11.  
  12. '31-Jul-91
  13. 'Cornel Huth
  14. 'C>bc XBTREE1/o;
  15. 'C>link /noe XBTREE1+nocom,XBTREE1.EXE,nul,QBTREE
  16. '
  17. 'C>XBTREE1 [/NL] [/DP]
  18. '/NL=no list all
  19. '/DP=do delete on every other key and record
  20.  
  21. 'common data structure in both the raw and the QBTree file
  22. 'doing it this way makes it easier to assign one to the other
  23.  
  24. TYPE CommonRecordTYPE
  25. partno AS STRING * 8
  26. desc AS STRING * 20
  27. cost AS STRING * 8
  28. pkgqty AS STRING * 2
  29. status AS STRING * 1
  30. END TYPE '39
  31.  
  32. 'raw data file FIXED.DAT has this record layout
  33. 'raw data happens to be already sorted, matters not
  34.  
  35. TYPE RawRecordTYPE
  36. info AS CommonRecordTYPE
  37. crlf AS STRING * 2
  38. END TYPE '41
  39. DIM RawRecord AS RawRecordTYPE
  40.  
  41. 'QBTree translation of FIXED.DAT record layout and a temporary string buffer
  42.  
  43. TYPE QBTRecordTYPE
  44. info AS CommonRecordTYPE
  45. END TYPE '39
  46. DIM QBTRecord AS QBTRecordTYPE
  47. DIM XferBuff AS STRING * 39
  48.  
  49. DIM LowValue AS STRING * 2
  50. DIM HiValue AS STRING * 2
  51. LowValue = CHR$(0) + CHR$(0)
  52. HiValue = CHR$(255) + CHR$(255)
  53.  
  54. cl$ = COMMAND$
  55.  
  56. CLS
  57. nul = QBTreeVer(ver)
  58. PRINT "WELCOME TO QBTree"; ver; "doing a little work..."
  59.  
  60. 'initialize QBTree to 1 key file, 1 data file
  61.  
  62. stat = InitQBTREE(1, 1)
  63. IF stat THEN GOTO Abend
  64.  
  65. 'create the data file (CATALOG.QBD)
  66. 'if it exists delete it
  67.  
  68. dbfile$ = "catalog.qbd"
  69. IF FileExists(dbfile$ + CHR$(0)) = -1 THEN KILL dbfile$
  70. stat = CreateDataFile(dbfile$, 39)
  71. IF stat THEN GOTO Abend
  72.  
  73. 'open the data file using QBTree file handle dbfile
  74. 'open for compatible mode read/write access
  75.  
  76. dbfile = FreeDataFile: IF dbfile = -1 THEN GOTO Abend
  77. OpenMode = 2
  78. stat = OpenDataFile(dbfile$, dbfile, OpenMode)
  79. IF stat THEN GOTO Abend
  80.  
  81. 'create the key file (CATALOG.QBX)
  82. 'if it exists delete it
  83.  
  84. kyfile$ = "catalog.qbx"
  85. IF FileExists(kyfile$ + CHR$(0)) = -1 THEN KILL kyfile$
  86. stat = CreateKeyFile(kyfile$, 8 + 2)'+2 for the 16-bit enumerator
  87. IF stat THEN GOTO Abend
  88.  
  89. 'open the key file using QBTree file handle kyfile
  90. 'open for compatible mode read/write access
  91.  
  92. kyfile = FreeKeyFile: IF kyfile = -1 THEN GOTO Abend
  93. OpenMode = 2
  94. stat = OpenKeyFile(kyfile$, kyfile, OpenMode)
  95. IF stat THEN GOTO Abend
  96.  
  97. 'setup pointer to QBTRecord and temporary transfer buffer
  98.  
  99. vseg = VARSEG(QBTRecord)
  100. voff = VARPTR(QBTRecord)
  101. xferseg = VARSEG(XferBuff)
  102. xferoff = VARPTR(XferBuff)
  103.  
  104. 'everything's setup to go
  105. 'we could use QBTree file I/O like ReadDevice(), DeleteFile(), etc., but
  106. 'for this example BASIC file I/O is used for simplicity
  107.  
  108. rawfile$ = "xdata1.dat"
  109. rawfile = FREEFILE
  110. OPEN rawfile$ FOR BINARY AS rawfile
  111.  
  112. 'read a fixed-length record from raw file and add it to the dbfile
  113.  
  114. PRINT "Importing records from "; rawfile$; ". Creating QBTree data and index files."
  115. PRINT " Records added";
  116.  
  117. 'preload first raw record
  118.  
  119. s1! = TIMER
  120. GET rawfile, , RawRecord
  121. DO WHILE NOT EOF(rawfile)
  122.  
  123.     'update QBTRecord only with the meaningful data in RawRecord
  124.     'transfer the data to a string that QBTree can use
  125.     '(first transfered to a fixed-len string so that this code example)
  126.     '(can be used in either QuickBASIC or BASIC PDS using far strings)
  127.     'write the QBTree record and key
  128.  
  129.     QBTRecord.info = RawRecord.info
  130.     MemCopy vseg, voff, xferseg, xferoff, LEN(QBTRecord)
  131.     Qrec$ = XferBuff
  132.     Qkey$ = UCASE$(LEFT$(XferBuff, 8)) + LowValue
  133.  
  134.     stat = AddKeyRecord(kyfile, dbfile, Qkey$, Qrec$)
  135.  
  136.     'if this key already exists handle it
  137.  
  138.     IF stat = 201 THEN
  139.        stat = GetEqual(kyfile, dbfile, LEFT$(Qkey$, 8) + HiValue, Qrec$)
  140.        stat = GetPrev(kyfile, dbfile, Qkey$, Qrec$)
  141.        enum$ = RIGHT$(Qkey$, 2)
  142.        enum$ = RIGHT$(enum$, 1) + LEFT$(enum$, 1)
  143.        enum = CVI(enum$)
  144.        enum = enum + 1
  145.        enum$ = MKI$(enum)
  146.        Qkey$ = LEFT$(Qkey$, 8) + RIGHT$(enum$, 1) + LEFT$(enum$, 1)
  147.        stat = AddKeyRecord(kyfile, dbfile, Qkey$, Qrec$)
  148.     END IF
  149.  
  150.     cnt& = cnt& + 1
  151.     LOCATE , 15: PRINT cnt&;
  152.     IF stat THEN EXIT DO
  153.  
  154.     'load next raw record
  155.  
  156.     GET rawfile, , RawRecord
  157. LOOP
  158. e1! = TIMER
  159. CLOSE rawfile
  160. PRINT USING " (####.# secs)"; e1! - s1!
  161. IF stat THEN GOTO Abend
  162.  
  163. 'delete every other record
  164.  
  165. IF INSTR(cl$, "/DP") THEN
  166.    PRINT "Deleting every other key and its data record."
  167.    PRINT " Records deleted";
  168.    cnt& = 0&
  169.    stat = GetFirst(kyfile, dbfile, Qkey$, Qrec$) 'leave odd records
  170.    DO UNTIL stat
  171.       stat = GetNext(kyfile, dbfile, Qkey$, Qrec$)
  172.       IF stat = 0 THEN
  173.          stat = DeleteKeyRecord(kyfile, dbfile, Qkey$)
  174.          cnt& = cnt& + 1
  175.          LOCATE , 17: PRINT cnt&;
  176.          IF stat = 0 THEN stat = GetNext(kyfile, dbfile, Qkey$, Qrec$)
  177.       END IF
  178.    LOOP
  179.  
  180.    'stat=202 is normal in the case above, it means end of file reached
  181.    IF stat = 202 THEN stat = 0
  182.    PRINT
  183.  
  184. END IF
  185.  
  186. IF stat THEN GOTO Abend
  187.  
  188. 'count all keys inorder, raw index speed--data file not accessed
  189.  
  190. cnt& = 0&
  191. PRINT "Counting all keys."
  192. PRINT " Keys counted";
  193. s1! = TIMER
  194. stat = RetrieveFirst(kyfile, Qkey$, Qrecno&)
  195. DO UNTIL stat
  196.    cnt& = cnt& + 1
  197.    LOCATE , 17: PRINT cnt&;
  198.    stat = RetrieveNext(kyfile, Qkey$, Qrecno&)
  199. LOOP
  200. e1! = TIMER
  201. PRINT USING " (####.# secs)"; e1! - s1!
  202.  
  203. 'stat=202 is normal in the case above, it means end of file reached
  204. IF stat = 202 THEN stat = 0
  205. IF stat THEN GOTO Abend
  206.  
  207. 'list all records of dbfile$ inorder by key
  208.  
  209. IF INSTR(cl$, "/NL") = 0 THEN
  210.    PRINT "Listing all records."
  211.    PRINT "RECORD  PARTNO-- DESC---------------- COST---- PKGQTY STATUS"
  212.    use$ = " #####  \      \ \                  \ \      \ \\     \\"
  213.    VIEW PRINT CSRLIN TO 24
  214.  
  215.    stat = GetFirst(kyfile, dbfile, Qkey$, Qrec$)
  216.    DO UNTIL stat
  217.       nul = GetPosition(kyfile, recno&)
  218.  
  219.       'copy the data record to the QBTRecord type
  220.  
  221.       XferBuff = Qrec$
  222.       MemCopy xferseg, xferoff, vseg, voff, LEN(QBTRecord)
  223.       
  224.       PRINT USING use$; recno&; QBTRecord.info.partno; QBTRecord.info.desc; QBTRecord.info.cost; QBTRecord.info.pkgqty; QBTRecord.info.status
  225.  
  226.       stat = GetNext(kyfile, dbfile, Qkey$, Qrec$)
  227.    LOOP
  228.    VIEW PRINT
  229.    LOCATE 24, 1
  230.    PRINT "Done.";
  231.  
  232.    'stat=202 is normal in the case above, it means end of file reached
  233.    IF stat = 202 THEN stat = 0
  234. END IF
  235.  
  236. Abend:
  237. IF stat THEN
  238.    stat2 = GetXEInfo(class, action, locus)
  239.    PRINT
  240.    PRINT "I/O error"; stat; "occured ( extended info error:"; stat2;
  241.    PRINT "class:"; class; "action:"; action; "locus:"; locus; ")"
  242. END IF
  243.  
  244. 'no stat check on the QBTree closes though it would be better to do so
  245.  
  246. stat = CloseDataFile(dbfile)
  247. stat = CloseKeyFile(kyfile)
  248. SYSTEM
  249.  
  250.